home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / m2pica.lha / M2Pica / Txt / Picatest8.mod < prev    next >
Text File  |  1995-08-21  |  4KB  |  133 lines
  1. (*******************************************************************************
  2.  : Program.         Picatest8.MOD
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : Version.         0.99
  7.  : Date.            22.Feb.1994
  8.  : Copyright.       PD
  9.  : Language.        Modula-2
  10.  : Compiler.        M2Amiga V4.3d
  11.  : Contents.        8-Bit Demoprogramm.
  12. *******************************************************************************)
  13.  
  14. MODULE PicaTest8 ;
  15.  
  16.  
  17. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG ;
  18.  
  19. FROM UtilityD     IMPORT tagEnd,tagDone ;
  20.  
  21. FROM Arts         IMPORT Assert ;
  22.  
  23. FROM ExecL        IMPORT Forbid,Permit ;
  24.  
  25. FROM DosL         IMPORT Delay ;
  26.  
  27. FROM GraphicsL    IMPORT SetRGB4 ;
  28.  
  29. FROM IntuitionD   IMPORT ScreenPtr ;
  30. FROM IntuitionL   IMPORT ScreenToFront ;
  31.  
  32. FROM RandomNumber IMPORT RND ;
  33.  
  34. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
  35.                          LockVillageScreen,UnLockVillageScreen,
  36.                          VillageRectFill,VillageBlitCopy,WaitVillageBlit,
  37.                          VillageModeRequest ;
  38. FROM VilIntuiSupD IMPORT SetPackedPixel,LinePacked,
  39.                          VilFillRecord,VilCopyRecord,VilScrCopy,VilScrAnd,
  40.                          VilDstInvert,VilScrPaint,TavisTags,InvalidID ;
  41.  
  42.  
  43.  
  44. VAR scr    : ScreenPtr ;
  45.     start  : ADDRESS ;
  46.     col    : LONGINT ;
  47.     mode   : LONGCARD ;
  48.     x,y,ok : LONGINT ;
  49.     tags   : ARRAY [0..40] OF LONGCARD ;
  50.     copy   : VilCopyRecord ;
  51.     fill   : VilFillRecord ;
  52.  
  53.  
  54.  
  55. BEGIN
  56.   mode := VillageModeRequest(TAG(tags,tavisMinDepth,  8,
  57.                                       tavisMaxDepth,  8,
  58.                                            tagDone)) ;
  59.   Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;
  60.  
  61.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenModeID,  mode,
  62.                                            tagDone)) ;
  63.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  64.  
  65.  
  66.   FOR col:=1 TO 255 DO
  67.     SetRGB4(ADR(scr^.viewPort),col,RND(255),RND(255),RND(255)) ;
  68.   END ;
  69.  
  70.   start := LockVillageScreen(scr) ;
  71.  
  72.   FOR x:=0 TO 500 DO
  73.     SetPackedPixel(scr,RND(scr^.width),RND(scr^.height),RND(255)) ;
  74.   END ;
  75.  
  76.   UnLockVillageScreen(scr) ;
  77.   Delay(3*50) ;
  78.  
  79.   FOR x:=0 TO 255 DO
  80.     LinePacked(scr,RND(scr^.width),RND(scr^.height),
  81.                    RND(scr^.width),RND(scr^.height),RND(255)) ;
  82.   END ;
  83.  
  84.   Delay(3*50) ;
  85.  
  86.   Forbid() ;
  87.    ScreenToFront(scr) ;
  88.    start := LockVillageScreen(scr) ;
  89.   Permit() ;
  90.  
  91.   FOR y:=0 TO (scr^.height DIV 32) DO
  92.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  93.       copy.scrAdr   := ADDRESS(LONGINT(start) + LONGINT(scr^.width) * (y*32) + x*32) ;
  94.       copy.dstAdr   := ADDRESS(LONGINT(start) + LONGINT(scr^.width)
  95.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32) ;
  96.       copy.scrPitch := scr^.width ;
  97.       copy.dstPitch := scr^.width ;
  98.       copy.width    := 31 ;
  99.       copy.height   := 31 ;
  100.       copy.rop      := VilScrPaint ;
  101.  
  102.       ok := VillageBlitCopy(scr,ADR(copy)) ;
  103.       WaitVillageBlit ;
  104.     END ;
  105.   END ;
  106.   Delay(3*50) ;
  107.  
  108.   FOR y:=0 TO (scr^.height DIV 32) DO
  109.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  110.       fill.dstAdr   := ADDRESS(LONGINT(start) + LONGINT(scr^.width)
  111.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32) ;
  112.       fill.dstPitch := scr^.width ;
  113.       fill.width    := 32 ;
  114.       fill.height   := 32 ;
  115.       fill.color    := RND(255) ;
  116.  
  117.       ok := VillageRectFill(scr,ADR(fill)) ;
  118.       WaitVillageBlit ;
  119.     END ;
  120.   END ;
  121.  
  122.   UnLockVillageScreen(scr) ;
  123.  
  124.   Delay(5*50) ;
  125.  
  126. CLOSE
  127.   IF scr#NIL THEN
  128.     UnLockVillageScreen(scr) ;
  129.     CloseVillageScreen(scr) ;
  130.   END ;
  131.  
  132. END PicaTest8 .
  133.